home *** CD-ROM | disk | FTP | other *** search
/ Aminet 41 / Aminet 41 (2001)(Schatztruhe)[!][Feb 2001].iso / Aminet / gfx / edit / AmiCAD_2.07.lha / AmiCAD / ARexx / TestNets.AmiCAD < prev    next >
Text File  |  2000-11-12  |  11KB  |  359 lines
  1. /* Test des erreurs sur un schéma, dans le but de créer une netlist.
  2.    Version 1.00: 14 Juillet 1998
  3.    Version 1.01: 6 février 1999 (ajout UNLOCK après erreur
  4.    Version 1.02: 27 février 1999 (ajout fonction INIT pour variables)
  5.    Version 1.03: 14 avril 2000 (adaptation version 2.05)
  6.    Version 1.04: 12 novembre 2000 (localisation anglais/français)
  7.    $VER: 1.04 (© R.Florac, 12/11/2000) */
  8.  
  9. options results     /* indispensable pour récupérer le résultat des macros */
  10.  
  11. signal on error     /* pour l'interception des erreurs */
  12. signal on syntax
  13.  
  14. 'LANGUAGE'
  15. if result="français.language" then fr=1
  16. else fr=0
  17.  
  18. c=1
  19. 'INIT(B,D,L,O,N):SAVEALL:UNMARK(-1):OBJECTS'; objets=result
  20. if objets=0 then do
  21.     if fr=1 then 'MESSAGE("Il n''y a aucun objet"+CHR(10)+"sur ce schéma !")'
  22.     else 'MESSAGE("There is no object"+CHR(10)+"on the document !")'
  23.     exit
  24. end
  25.  
  26. 'DEF UNMARKCOMP(O)=IF(GETREF(O),UNMARK(GETREF(O)),0):IF(GETVAL(O),UNMARK(GETVAL(O)),0):UNMARK(O)'
  27.  
  28. modifs=0; eliminations=0; errrefs=0; errvals=0; errconx=0; doublets=0
  29. if fr=1 then do
  30.     c="Test du schéma"||'0a'x||"1- Vérifier les références "||'0a'x||"2- Vérifier les valeurs    "||'0a'x||"3- Vérifier les connexions "||'0a'x||"4- Vérifier les liaisons   "||'0a'x||"5- Tester présence doublons"||'0a'x
  31.     c=c||"6- Enchaîner tous les tests"||'0a'x||"7-       Abandonner        "
  32. end
  33. else do
  34.     c="Document test"||'0a'x||"1- Verify references"||'0a'x||"2- Verify values    "||'0a'x||"3- Verify junctions "||'0a'x||"4- Verify nets      "||'0a'x||"5- Check duplicates "||'0a'x
  35.     c=c||"6- Do all tests     "||'0a'x||"7- Cancel           "
  36. end
  37. 'SELECT("'c'")'
  38. c=result
  39. select
  40.     when c=1 then call test_refs
  41.     when c=2 then call test_valeurs
  42.     when c=3 then call test_connexions
  43.     when c=4 then call test_liaisons
  44.     when c=5 then call test_doublets
  45.     when c=6 then do
  46.     call test_doublets
  47.     call test_refs
  48.     call test_valeurs
  49.     call test_connexions
  50.     call test_liaisons
  51.     end
  52.     otherwise do
  53.     'INIT(B,D,L,O,N)'
  54.     exit
  55.     end
  56. end
  57. call afficher_erreurs
  58. 'INIT(B,D,L,O,N)'
  59. exit
  60.  
  61. test_refs:
  62.     if fr=1 then 'LOCK:TITLE("Vérification des références...")'
  63.     else 'LOCK:TITLE("Verifying references...")'
  64.     do i=1 to objets
  65.     'TYPE(O='i')'
  66.     if result=1 then do
  67.         'PARTNAME(O)'
  68.         if result~="ALIMENTATION" & result ~="MASSE" then do
  69.         'GETREF(O)'
  70.         if result=0 then do
  71.             if fr=1 then 'MARK(O):REQUEST("Attention l''objet 'i'"+CHR(10)+"("+PARTNAME(O)+")"+CHR(10)+"situé en "+STR(COL(O))+" "+STR(LINE(O))+CHR(10)+"n''a pas de référence"+CHR(10)+"Voulez-vous continuer?")'
  72.             else 'MARK(O):REQUEST("Warning: object 'i'"+CHR(10)+"("+PARTNAME(O)+")"+CHR(10)+"located at "+STR(COL(O))+" "+STR(LINE(O))+CHR(10)+"has no reference"+CHR(10)+"Do-you want to continue?")'
  73.             if result<1 then do
  74.             'UNLOCK'
  75.             return
  76.             end
  77.             'UNMARKCOMP(O)'
  78.             errrefs=errrefs+1
  79.         end
  80.         end
  81.     end
  82.     end
  83.     'UNLOCK'
  84. return
  85.  
  86. test_valeurs:
  87.     if fr=1 then 'LOCK:TITLE("Vérification des valeurs..."):UNMARK(-1)'
  88.     else 'LOCK:TITLE("Verifying values..."):UNMARK(-1)'
  89.     do i=1 to objets
  90.     'TYPE(O='i')'
  91.     if result=1 then do
  92.         'PARTNAME(O)'
  93.         if result~="ALIMENTATION" & result ~="MASSE" then do
  94.         'GETVAL(O)'
  95.         if result=0 then do
  96.             if fr=1 then 'MARK(O):REQUEST("Attention l''objet 'i'"+CHR(10)+"("+PARTNAME(O)+")"+CHR(10)+"situé en "+STR(COL(O))+" "+STR(LINE(O))+CHR(10)+"n''a pas de valeur"+CHR(10)+"Voulez-vous continuer?")'
  97.             else 'MARK(O):REQUEST("Warning: object 'i'"+CHR(10)+"("+PARTNAME(O)+")"+CHR(10)+"located at "+STR(COL(O))+" "+STR(LINE(O))+CHR(10)+"has no value"+CHR(10)+"Do-you want to continue?")'
  98.             if result<1 then do
  99.             'UNLOCK'
  100.             return
  101.             end
  102.             'UNMARKCOMP(O)'
  103.             errvals=errvals+1
  104.         end
  105.         end
  106.     end
  107.     end
  108.     'UNLOCK'
  109. return
  110.  
  111. test_doublets:
  112.     if fr=1 then 'LOCK:TITLE("Vérification absence éléments doubles..."):UNMARK(-1)'
  113.     else 'LOCK:TITLE("Checking for duplicates objects..."):UNMARK(-1)'
  114.     i=1
  115.     do while i>0
  116.     'O=FINDOBJ('i',1,-1,-1)'; i=result
  117.     if i>0 then do
  118.         'N=FINDOBJ('i+1',1,COL(O),LINE(O))'; j=result
  119.         if j>0 then do
  120.         'IF(PARTNAME(O)==PARTNAME(N),IF(GETREF(N),DELETE(GETREF(N)),0):IF(GETVAL(N),DELETE(GETVAL(N)),0):DELETE(N):MARK(O),0):OBJECTS'; objets=result
  121.         doublets=doublets+1
  122.         end
  123.         if i>=objets-1 then i=0
  124.         else i=i+1
  125.     end
  126.     end
  127.     i=1
  128.     do while i>0
  129.     'O=FINDOBJ('i',1,-1,-1)'; i=result
  130.     if i>0 then do
  131.         'GETREF(O)'; r=result
  132.         if r>0 then do
  133.         'D=FINDREF('i+1',READTEXT(GETREF(O)))'; d=result
  134.         if d>0 then do
  135.             if fr=1 then 'MARK(O,D):MESSAGE("Attention: la référence"+CHR(10)+READTEXT(GETREF(O))+CHR(10)+"est utilisée deux fois!")'
  136.             else 'MARK(O,D):MESSAGE("Warning: reference"+CHR(10)+READTEXT(GETREF(O))+CHR(10)+"is used twice !")'
  137.         end
  138.         end
  139.         if i>=objets-1 then i=0
  140.         else i=i+1
  141.     end
  142.     end
  143.     'UNLOCK'
  144. return
  145.  
  146. test_connexions:
  147.     if fr=1 then 'LOCK:TITLE("Vérification des liaisons aux composants..."):UNMARK(-1)'
  148.     else 'LOCK:TITLE("Verifying nets..."):UNMARK(-1)'
  149.     i=1
  150.     do while i>0
  151.     'O=FINDOBJ('i',1,-1,-1)'; i=result
  152.     if i>0 then do
  153.         'PARTNAME(O)'
  154.         'DEVPINS(O)'; j=result
  155.         do k=1 to j
  156.         if connexion_broche(i,k)=0 then do
  157.             if fr=1 then do
  158.               'MARK(O):REQUEST("Attention l''objet 'i'"+CHR(10)+"("+PARTNAME(O)+")"+CHR(10)+"situé en "+STR(COL(O))+" "+STR(LINE(O))+CHR(10)+"a sa borne "+STR(IF(PINNUM(O,'k'),PINNUM(O,'k'),'k'))+" non connectée"+CHR(10)+"Voulez-vous continuer?")'
  159.             end
  160.             else do
  161.               'MARK(O):REQUEST("Warning: object 'i'"+CHR(10)+"("+PARTNAME(O)+")"+CHR(10)+"located at "+STR(COL(O))+" "+STR(LINE(O))+CHR(10)+"has pin "+STR(IF(PINNUM(O,'k'),PINNUM(O,'k'),'k'))+" not connected"+CHR(10)+"Do-you want to continue ?")'
  162.             end
  163.             if result<1 then do
  164.             'UNLOCK'
  165.             return
  166.             end
  167.             'UNMARKCOMP(O)'
  168.             errconx=errconx+1
  169.         end
  170.         end
  171.         if i=objets then leave
  172.         i=i+1
  173.     end
  174.     end
  175.     'UNLOCK'
  176. return
  177.  
  178. test_liaisons:
  179.     if fr=1 then 'LOCK:TITLE("Recherche et élimination lignes inutiles...")'
  180.     else 'LOCK:TITLE("Searching unusefull lines...")'
  181.     i=1
  182.     do while i>0
  183.     'O=FINDOBJ('i',2,-1,-1)'; i=result
  184.     if i>0 then do
  185.         'IF((COL(O)==ENDCOL(O))&(LINE(O)==ENDLINE(O)),DELETE(O),0)'
  186.         if result>0 then do
  187.         objets=result
  188.         eliminations=eliminations+1
  189.         end
  190.         else if i<objets then do
  191.         'IF(COL(O)==ENDCOL(O),1,IF(LINE(O)==ENDLINE(O),2,0))'
  192.         if result=1 then do    /* c'est une ligne verticale */
  193.             l=i+1
  194.             do while l>0
  195.             'L=FINDOBJ('l',2,COL(O),-1)'; l=result
  196.             if l>0 then do
  197.                 'IF(COL(L)==ENDCOL(L),COORDS(O)+","+COORDS(L),"")'
  198.                 if result~="" then do
  199.                 parse var result x0','y0','x1','y1','x2','y2','x3','y3
  200.                 y4=min(y0,y1)
  201.                 y5=max(y0,y1)
  202.                 y6=min(y2,y3)
  203.                 y7=max(y2,y3)
  204.                 if y4<y7 & y5>y6 then call modifier_lignes(x0,min(y4,y6),x0,max(y5,y7))
  205.                 else if y4=y7 then do
  206.                     'FINDOBJ(1,7,'x0','y4')'
  207.                     if result=0 then call modifier_lignes(x0,y6,x0,y5)
  208.                 end
  209.                 else if y5=y6 then do
  210.                     'FINDOBJ(1,7,'x0','y5')'
  211.                     if result=0 then call modifier_lignes(x0,y4,x0,y7)
  212.                 end
  213.                 end
  214.             end
  215.             if l>0 then do
  216.                 if l>=objets then l=0
  217.                 else l=l+1
  218.             end
  219.             end
  220.         end
  221.         else if result=2 then do    /* c'est une ligne horizontale */
  222.             l=i+1
  223.             do while l>0
  224.             'L=FINDOBJ('l',2,-1,LINE(O))'; l=result
  225.             if l>0 then do
  226.                 'IF(LINE(L)==ENDLINE(L),COORDS(O)+","+COORDS(L),"")' /* est-ce bien une ligne horizontale? */
  227.                 if result~="" then do
  228.                 parse var result x0','y0','x1','y1','x2','y2','x3','y3
  229.                 x4=min(x0,x1)
  230.                 x5=max(x0,x1)
  231.                 x6=min(x2,x3)
  232.                 x7=max(x2,x3)
  233.                 if x4<x7 & x5>x6 then call modifier_lignes(min(x4,x6),y0,max(x5,x7),y0)
  234.                 else if x4=x7 then do
  235.                     'FINDOBJ(1,7,'x4','y0')'
  236.                     if result=0 then call modifier_lignes(x6,y0,x5,y0)
  237.                 end
  238.                 else if x5=x6 then do
  239.                     'FINDOBJ(1,7,'x5','y0')'
  240.                     if result=0 then call modifier_lignes(x4,y0,x7,y0)
  241.                 end
  242.                 end
  243.             end
  244.             if l>0 then do
  245.                 if l>=objets then l=0
  246.                 else l=l+1
  247.             end
  248.             end
  249.         end
  250.         end
  251.         if i>=objets-1 then i=0
  252.         else i=i+1
  253.     end
  254.     else leave
  255.     end
  256.     'UNLOCK'
  257. return
  258.  
  259. afficher_erreurs:
  260.     if fr=1 then do
  261.     if eliminations=0 & modifs=0 & errrefs=0 & errvals=0 & errconx=0 & doublets=0 then 'MESSAGE("Vérification terminée"+CHR(10)+"Aucune erreur trouvée")'
  262.     else do
  263.         t=""
  264.         if eliminations>0 then t=eliminations||" lignes nulles éliminées"
  265.         if modifs>0 then do
  266.         if t~="" then t=t||'0a'x||modifs||" lignes modifiées"
  267.         else t=modifs||" lignes modifiées"
  268.         end
  269.         if errrefs>0 then do
  270.         if t~="" then t=t||'0a'x||errrefs||" références manquantes"
  271.         else t=errrefs||" références manquantes"
  272.         end
  273.         if errvals>0 then do
  274.         if t~="" then t=t||'0a'x||errvals||" valeurs manquantes"
  275.         else t=errvals||" valeurs manquantes"
  276.         end
  277.         if errconx>0 then do
  278.         if t~="" then t=t||'0a'x||errconx||" connexions manquantes"
  279.         else t=errconx||" connexions manquantes"
  280.         end
  281.         if doublets>0 then do
  282.         if t~="" then t=t||'0a'x||doublets||" éléments supprimés"
  283.         else t=doublets||" éléments supprimés"
  284.         end
  285.         'MESSAGE("'t'")'
  286.     end
  287.     end
  288.     else do
  289.     if eliminations=0 & modifs=0 & errrefs=0 & errvals=0 & errconx=0 & doublets=0 then 'MESSAGE("Vérification terminée"+CHR(10)+"No error found")'
  290.     else do
  291.         t=""
  292.         if eliminations>0 then t=eliminations||" null lines eliminated"
  293.         if modifs>0 then do
  294.         if t~="" then t=t||'0a'x||modifs||" modified lines"
  295.         else t=modifs||" modified lines"
  296.         end
  297.         if errrefs>0 then do
  298.         if t~="" then t=t||'0a'x||errrefs||" missing references"
  299.         else t=errrefs||" missing references"
  300.         end
  301.         if errvals>0 then do
  302.         if t~="" then t=t||'0a'x||errvals||" missing values"
  303.         else t=errvals||" missing values"
  304.         end
  305.         if errconx>0 then do
  306.         if t~="" then t=t||'0a'x||errconx||" missing junctions"
  307.         else t=errconx||" missing junctions"
  308.         end
  309.         if doublets>0 then do
  310.         if t~="" then t=t||'0a'x||doublets||" deleted objects"
  311.         else t=doublets||" deleted objects"
  312.         end
  313.         'MESSAGE("'t'")'
  314.     end
  315.     end
  316.     return
  317.  
  318. modifier_lignes:
  319.     parse arg xd,yd,xf,yf
  320.     'DRAWMODE(1):DELETE(L):DELETE(O):MARK(DRAW('xd','yd','xf','yf'))'
  321.     objets=objets-1
  322.     i=0; l=0
  323.     modifs=modifs+1
  324.     return
  325.  
  326. connexion_broche: procedure
  327.     parse arg objet,broche
  328.     'PINCOL(O='objet',B='broche')'; xj=result
  329.     'PINLINE(O,B)'; yj=result
  330.     'FINDOBJ(1,2,'xj','yj')'; xl=result     /* Il y a t'il une ligne qui part de la broche? */
  331.     if xl>0 then return xl
  332.     'FINDLINE(1,'xj','yj')'; xl=result      /* Il y a peut être une ligne qui passe SUR la broche... */
  333.     if xl<=0 then return 0
  334.     'FINDOBJ(1,7,'xj','yj')'                /* Il doit alors y avoir une jonction */
  335.     if result>0 then return xl
  336.     return 0
  337.  
  338. min: procedure
  339.     parse arg v1,v2
  340.     if v1<v2 then return v1
  341.     return v2
  342.  
  343. max: procedure
  344.     parse arg v1,v2
  345.     if v1>v2 then return v1
  346.     return v2
  347.  
  348. /* Traitement des erreurs, interruption du programme */
  349. syntax:
  350. erreur=RC
  351. if fr=1 then 'UNLOCK:MESSAGE("Erreur de syntaxe"+CHR(10)+"en ligne 'SIGL'"+CHR(10)+"'errortext(erreur)'"):INIT(B,D,L,O,N)'
  352. else 'UNLOCK:MESSAGE("Syntax error"+CHR(10)+"in line 'SIGL'"+CHR(10)+"'errortext(erreur)'"):INIT(B,D,L,O,N)'
  353. exit
  354.  
  355. error:
  356. if fr=1 then 'UNLOCK:MESSAGE("Erreur en ligne 'SIGL'"):INIT(B,D,L,O,N)'
  357. else 'UNLOCK:MESSAGE("Error in line 'SIGL'"):INIT(B,D,L,O,N)'
  358. exit
  359.